(module woof-primitives mzscheme
  (require (only (lib "swindle.ss" "swindle")
                 push! pop! rest)) ;provides oo stuff
  (require (only (lib "misc.ss" "swindle")
                 list-set!)) ;misc helpers
  (require (lib "list.ss" "srfi" "1")) ;pre-prefixed with s:
  (require (lib "34.ss" "srfi")) ;provides exception handling
  (require (all-except (lib "43.ss" "srfi")
                       vector->list
                       vector-fill!))
  (require (lib "defmacro.ss"))
  (require (lib "kw.ss"))
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 1)))
  (require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
  (require (planet "read.ss" ("ryanc" "scripting.plt" 1))) ;provides read-all
  (require "woof-kernel.scm")
  (require "woof-machine-utils.scm")
  (require (lib "file.ss"))
  (require (lib "port.ss"))
  (require (lib "process.ss"))


  ;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; primitive functions ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;

  
  (define prim-write_string
    (lambda (state) 
      (let* ((str (pop-stack! state))
	     (port (woof-object-prim-data (pop-stack! state)))
	     (prim-str (woof-object-prim-data str)))
	(write-string prim-str port)
	(push-stack! str state))))
  
  
  (define prim-new_instance
    (lambda (state) 
      (push-stack! (woof-instance
		    (pop-stack! state))
		   state)))
  
  (define prim-create_class
    (lambda (state) 
      (let* ((s-name (woof-object-prim-data
		      (pop-stack! state)))
	     (super (pop-stack! state))
	     (vars (pop-stack! state))
	     (classVars (pop-stack! state))
	     (new-class
	      (create-class
	       s-name
	       super
	       (machine-state-globals state))))
	(install-class! new-class (machine-state-globals state))
	(push-stack! new-class state))))
  
  (define prim-show_object
    (lambda (state) 
      (let* ((class (woof-object-class (pop-stack! state)))
	     (class-name (woof-class-object-name class))
	     (desc (string-append
		    "<instance of "
		    class-name
		    ">"
		    )))
	(push-stack! (woof-string-instance
		      desc
		      (machine-state-globals state))
		     state))))
  
  (define prim-show_number
    (lambda (state) 
      (let* ((i (woof-object-prim-data (pop-stack! state)))
	     (desc (number->string i)))
	(push-stack! (woof-string-instance
		      desc
		      (machine-state-globals state))
		     state))))
  
  (define prim-list_ref
    (lambda (state) 
      (let ((s-list (woof-object-prim-data (pop-stack! state)))
	    (s-index (woof-object-prim-data (pop-stack! state))))
	(if (> (length s-list) s-index)
	    (push-stack! (list-ref s-list s-index) state)
	    (push-stack! (woof-nil (machine-state-globals state)) state)))))
  
  (define prim-integer_add
    (lambda (state) 
      (push-stack! (woof-integer-instance (+ (woof-object-prim-data (pop-stack! state))
					     (woof-object-prim-data (pop-stack! state)))
					  (machine-state-globals state))
		   state)))
  
  (define prim-integer_greater_than
    (lambda (state) 
      (push-stack! (woof-boolean-instance (> (woof-object-prim-data
					      (pop-stack! state))
					     (woof-object-prim-data
					      (pop-stack! state)))
					  (machine-state-globals state))
		   state)))
  
  (define prim-integer_less_than
    (lambda (state) 
      (push-stack! (woof-boolean-instance (< (woof-object-prim-data
					      (pop-stack! state))
					     (woof-object-prim-data
					      (pop-stack! state)))
					  (machine-state-globals state))
		   state)))
  
  (define prim-integer_greater_than_or_equal
    (lambda (state) 
      (push-stack! (woof-boolean-instance (>= (woof-object-prim-data
					       (pop-stack! state))
					      (woof-object-prim-data
					       (pop-stack! state)))
					  (machine-state-globals state))
		   state)))
  
  (define prim-get_instance_var
    (lambda (state) 
      (let ((object (pop-stack! state))
	    (field-name (woof-object-prim-data (pop-stack! state))))
	(push-stack! (read-woof-object-field object field-name (machine-state-globals state)) state))))
  
  (define prim-set_instance_var
    (lambda (state) 
      (let ((object (pop-stack! state))
	    (field-name (woof-object-prim-data (pop-stack! state)))
	    (value (pop-stack! state)))
	(push-stack! (set-woof-object-field! object field-name value (machine-state-globals state)) state))))
  
  (define prim-obj_eq
    (lambda (state) 
      (push-stack! (woof-boolean-instance (eq? (pop-stack! state) (pop-stack! state))
					  (machine-state-globals state))
		   state)))
  
  (define prim-string_concat
    (lambda (state) 
      (let ((str1 (woof-object-prim-data (pop-stack! state)))
	    (str2 (woof-object-prim-data (pop-stack! state))))
	(push-stack! (woof-string-instance
		      (string-append str1 str2) (machine-state-globals state)) state))))
  
  (define prim-list_concat
    (lambda (state) 
      (let ((list1 (woof-object-prim-data (pop-stack! state)))
	    (list2 (woof-object-prim-data (pop-stack! state))))
	(push-stack! (woof-list-instance
		      (append list1 list2) (machine-state-globals state)) state))))
  
  (define prim-string_length
    (lambda (state) 
      (push-stack! (woof-integer-instance
		    (string-length (woof-object-prim-data
				    (pop-stack! state))) (machine-state-globals state)) state)))
  
  (define prim-list_length
    (lambda (state) 
      (push-stack! (woof-integer-instance
		    (length (woof-object-prim-data
			     (pop-stack! state))) (machine-state-globals state)) state)))
  
  
   (provide (all-defined)) 
)